Whiteline: Alpha/Whiteline Alpha.iso/progtool/modula2/lpr/realinou.mod

Modula Implementation | 1994-09-22 | 23.7 KB | 864 lines

IMPLEMENTATION MODULE RealInOut;

FROM InOut    IMPORT Write, ReadString, WriteString;
FROM SYSTEM   IMPORT ADR, LONG;
FROM System   IMPORT FLOATd, TRUNCd;
IMPORT InOut;

  CONST LenText = 80;
  TYPE  String  = ARRAY [0..LenText] OF CHAR;

    CONST MaxDigits = 8;
    VAR   neg : BOOLEAN;
          a   : REAL;
          i   : INTEGER;
          MINREAL : REAL;
          nul : INTEGER; (* ORD('0') *)

    PROCEDURE atoi(a : REAL; i : INTEGER; VAR OK : BOOLEAN) : REAL;
      VAR b   : REAL;
          k,m : CARDINAL;
          ib : RECORD
                 CASE : BOOLEAN OF
                   TRUE : i : INTEGER |
                   FALSE: b : BITSET
                 END
               END;
      BEGIN
        b:=1.0;
        IF i<0 THEN
          i:=-i;
          a:=1.0/a
        ELSIF i=0 THEN
          OK:=TRUE;
          RETURN b
        END;
        m:=15;
        ib.i:=i;
        WHILE ~(m IN ib.b) DO DEC(m) END;
        FOR k:=0 TO m DO
          IF k IN ib.b THEN b:=b*a END;
          IF k<m THEN
            IF ABS(a)>1.0 THEN
              OK:=(ABS(b)<(MAX(REAL)/a)/a) & (ABS(a)<MAX(REAL)/ABS(a))
            ELSIF ABS(a)<1.0 THEN
              OK:=(ABS(b)>(MINREAL/a)/a) & (ABS(a)>MINREAL/ABS(a))
            ELSE
              OK:=TRUE
            END;
            IF OK THEN a:=a*a ELSE RETURN 0.0 END
          END
        END;
        RETURN b
      END atoi;

    PROCEDURE StringToReal
              (VAR s : ARRAY OF CHAR; VAR val : REAL; VAR ReadOK : BOOLEAN);
      VAR nege   : BOOLEAN;
          pos    : INTEGER;
          i,temp : INTEGER;
          tch    : CHAR;
          rval, sval, fct  : REAL;
      PROCEDURE ReadCH(VAR ch : CHAR);
        BEGIN
          ReadOK:=pos<HIGH(s);
          IF ReadOK THEN
            ch:=s[pos];
            INC(pos)
          ELSE
            ch:=' '
          END
        END ReadCH;
    BEGIN
      pos:=0;
      ReadCH(tch);
      IF ~ReadOK THEN RETURN END;
      WHILE tch=' ' DO
        ReadCH(tch);
        IF ~ReadOK THEN RETURN END
      END;
      neg:=tch='-';
      IF neg OR (tch='+') THEN
        ReadCH(tch);
        IF ~ReadOK THEN RETURN END
      END;
      sval:=0.0;
      ReadOK:=FALSE;
      WHILE (tch>='0') AND (tch<='9') DO
        sval:=10.0*sval+FLOAT(ORD(tch)-ORD('0'));
        ReadCH(tch);
        IF ~ReadOK THEN RETURN END
      END;
      IF tch='.' THEN
        ReadCH(tch);
        IF ~ReadOK THEN RETURN END;
        rval:=1.0;
        WHILE (tch>='0') AND (tch<='9') DO
          sval:=10.0*sval+FLOAT(ORD(tch)-ORD('0'));
          rval:=10.0*rval;
          ReadCH(tch);
          IF ~ReadOK THEN RETURN END
        END;
        sval:=sval/rval
      END;
      IF tch='E' THEN
        ReadCH(tch);
        IF ~ReadOK THEN RETURN END;
        nege:=tch='-';
        IF nege OR (tch='+') THEN
          ReadCH(tch);
          IF ~ReadOK THEN RETURN END
        END;
        i:=0;
        LOOP
          IF (tch<'0') OR (tch>'9') THEN EXIT END;
          temp:=ORD(tch)-ORD('0');
          i:=10*i+temp;
          ReadCH(tch);
          IF ~ReadOK THEN RETURN END
        END;
        fct:=atoi(10.0,i,ReadOK);
        IF ~ReadOK THEN RETURN END;
        IF nege THEN
          ReadOK:=sval>MINREAL*fct;
          IF ~ReadOK THEN RETURN END;
          sval:=sval/fct
        ELSE
          ReadOK:=sval<MAX(REAL)/fct;
          IF ~ReadOK THEN RETURN END;
          sval:=sval*fct
        END
      END;
      IF ~ReadOK THEN RETURN END;
      IF neg THEN sval:=-sval END;
      val:=sval;
      ReadOK:=tch<=' '
    END StringToReal;

    PROCEDURE ReadReal(VAR a : REAL);
      VAR s : String;
      BEGIN
        ReadString(s);
        Done:=InOut.Done;
        IF Done THEN StringToReal(s,a,Done) END
      END ReadReal;

    PROCEDURE PreScale;
    (*        Convert the number to be in the range 1 to 10 (unless zero)
              i returns places shifted in process *)
      BEGIN
        neg:=a<0.0;
        IF neg THEN a:=-a END;
        (* calculate whole digits size *)
        i:=0;
        IF a<>0.0 THEN
          WHILE a>=1.0E7 DO
            a:=a/1.0E7;
            INC(i,7)
          END;
          WHILE a>=10.0 DO
            a:=a/10.0;
            INC(i)
          END;
          WHILE a<1.0E-7 DO
            a:=1.0E7*a;
            DEC(i,7);
            IF i<-38 THEN
              i:=0;
              a:=0.0;
              RETURN
            END
          END;
          WHILE a<1.0 DO
            a:=10.0*a;
            DEC(i);
            IF i<-38 THEN
              i:=0;
              a:=0.0;
              RETURN
            END
          END
        END
      END PreScale;

    PROCEDURE RealToString
                 (VAR Text : ARRAY OF CHAR; c : REAL; size : INTEGER);
      (* output a real number *)
      VAR sigdigits       : INTEGER;
          placesbeforedot : INTEGER;
          pos             : INTEGER;
          j,k,l           : INTEGER;
          chs             : ARRAY [1..15] OF CHAR;
          dummy           : BOOLEAN;
      PROCEDURE WriteCH(ch : CHAR);
        BEGIN
          IF pos<HIGH(Text) THEN
            Text[pos]:=ch;
            INC(pos)
          END
        END WriteCH;
      BEGIN
        IF size>=HIGH(Text) THEN size:=HIGH(Text)-1 END;
        pos:=0;
        a:=c;
        PreScale;
        placesbeforedot:=1;

        (*      Convert to engineering form if required.
                This code does so by shifting more digits in front of
                the dot.
                If you want to shift the other way, change the signs
                on the numbers. *)

        IF Engineering THEN
          WHILE (i MOD 3)<>0 DO
            DEC(i);
            INC(placesbeforedot);
          END
        END;

        (*      placesbeforedot now contains the number of places to
                precede the decimal point *)

        sigdigits:=size-6;
        IF sigdigits>SigDigits THEN sigdigits:=SigDigits END;
        IF sigdigits<2 THEN sigdigits:=2 END;
        IF sigdigits>MaxDigits THEN sigdigits:=MaxDigits END;
        IF Engineering & (sigdigits<3) THEN sigdigits:=3 END;
        IF size>sigdigits+6 THEN
          FOR l:=size-(sigdigits+6) TO 1 BY -1 DO WriteCH(' ') END
        END;
        IF neg THEN
          WriteCH('-')
        ELSE
          WriteCH(' ')
        END;

        (*      write out the number *)

        a:=a+atoi(0.1,sigdigits,dummy)*5.0;
        IF TRUNC(a)>9 THEN
          a:=a/10.0;
          INC(i)
        END;
        FOR l:=1 TO sigdigits DO
           k:=TRUNC(a);
           IF k>9 THEN
             k:=9;
             a:=10.0
           END;
           WriteCH(CHR(k+ORD('0')));
           a:=10.0*(a-FLOAT(k));
           IF a<0.0 THEN a:=0.0 END;
           IF l=placesbeforedot THEN WriteCH('.') END
         END;
         IF (i<>0) OR ForceExponent THEN
           WriteCH('E');
           IF i<0 THEN
             WriteCH('-');
             i:=-i
           ELSE
             WriteCH('+');
           END;
           FOR k:=1 TO 2 DO
             j:=i DIV 10;
             l:=i-10*j;
             chs[k]:=CHR(l+ORD('0'));
             i:=j
           END;
           FOR k:=2 TO 1 BY -1 DO  WriteCH(chs[k]) END
         END;
         Text[pos]:=0C
       END RealToString;

    PROCEDURE WriteReal(c : REAL; size : INTEGER);
      VAR s : String;
      BEGIN
        RealToString(s,c,size);
        WriteString(s)
      END WriteReal;

    PROCEDURE RealToStringFixed
              (VAR Text : ARRAY OF CHAR; x : REAL; size, places : INTEGER);
      (*  output a real number *)
      VAR  placesbeforedot  : INTEGER;
           wholeplaces      : INTEGER;
           pos, k, l        : INTEGER;
           digitnumber      : INTEGER;
           storeSigDigits   : INTEGER;
           storeEngineering : BOOLEAN;
           dummy            : BOOLEAN;
      PROCEDURE WriteCH(ch : CHAR);
        BEGIN
          IF pos<HIGH(Text) THEN
            Text[pos]:=ch;
            INC(pos)
          END
        END WriteCH;
      BEGIN
        IF size>=HIGH(Text) THEN size:=HIGH(Text)-1 END;
        pos:=0;
        a:=x;
        PreScale;
        IF places>7 THEN places:=7 END;
        IF size=0 THEN size:=1 END;
        IF (size=1) & neg THEN size:=2 END;
        IF places>size-1 THEN places:=size-1 END;
        placesbeforedot:=size-places-1;
        IF neg & (placesbeforedot>0)THEN DEC(placesbeforedot) END;
        IF i<=0 THEN
          wholeplaces:=1;
          a:=ABS(x);
          i:=0
        ELSE
          wholeplaces:=i+1
        END;
        IF wholeplaces>placesbeforedot THEN
          storeSigDigits:=SigDigits;
          storeEngineering:=Engineering;
          SigDigits:=places+1;
          Engineering:=FALSE;
          RealToString(Text,x,size);
          SigDigits:=storeSigDigits;
          Engineering:=storeEngineering;
          RETURN
        END;
        a:=a+atoi(0.1,wholeplaces+places,dummy)*5.0;
        FOR l:=placesbeforedot TO wholeplaces+1 BY -1 DO WriteCH(' ') END;
        IF neg THEN WriteCH('-') END;
        digitnumber:=1;
        FOR l:=wholeplaces TO 1 BY -1 DO
          k:=TRUNC(a);
          IF k>9 THEN k:=9 END;
          IF digitnumber<=MaxDigits THEN
            WriteCH(CHR(k+ORD('0')))
          ELSE
            WriteCH('0')
          END;
          INC(digitnumber);
          a:=10.0*(a-FLOAT(k));
          IF a<0.0 THEN a:=0.0 END
        END;
        IF digitnumber<=MaxDigits THEN WriteCH('.') ELSE WriteCH(' ') END;
        FOR l:=1 TO places DO
          k:=TRUNC(a);
          IF k>9 THEN k:=9; a:=10.0 END;
          IF digitnumber<=MaxDigits THEN
            WriteCH(CHR(k+ORD('0')))
          ELSE
            WriteCH(' ')
          END;
          INC(digitnumber);
          a:=10.0*(a-FLOAT(k));
          IF a<0.0 THEN a:=0.0 END
        END;
        Text[pos]:=0C
      END RealToStringFixed;

    PROCEDURE WriteRealFixed(x : REAL; size, places : INTEGER);
      VAR s : String;
      BEGIN
        RealToStringFixed(s,x,size,places);
        WriteString(s)
      END WriteRealFixed;


    CONST LMaxDigits = 16;
    VAR   La      : LONGREAL;
          MinLong : LONGREAL;
          One,Five,Ten,Tenth,Zero,E14,EM4,EM8,EM12,EM14,EM16,EM20,
          TwoEM16  : LONGREAL;

    PROCEDURE Rec(x : LONGREAL) : LONGREAL;
      VAR y,d : LONGREAL;
      BEGIN
        y:=One/x;
        REPEAT
          d:=x*y-One;
          y:=y*(One-d);
        UNTIL ABS(d)<TwoEM16;
        RETURN y
      END Rec;

  PROCEDURE Long(a,b,c,d,e,f : INTEGER) : LONGREAL;
    VAR Sum : LONGREAL;
        n   : INTEGER;
    BEGIN
      INC(f);
      Sum:=FLOATd(a)*EM4+FLOATd(b)*EM8+FLOATd(c)*EM12+
           FLOATd(d)*EM16+FLOATd(e)*EM20;
      IF f=0 THEN RETURN Sum END;
      IF f>0 THEN
        FOR n:=1 TO f DO Sum:=Sum*Ten END
      ELSE
        FOR n:=1 TO -f DO Sum:=Sum*Tenth END
      END;
      RETURN Sum
    END Long;

    PROCEDURE Latoi
                (La : LONGREAL; i : INTEGER; VAR OK : BOOLEAN) : LONGREAL;
      VAR b,r : LONGREAL;
          k,m : CARDINAL;
          ib : RECORD
                 CASE : BOOLEAN OF
                   TRUE : i : INTEGER |
                   FALSE: b : BITSET
                 END
               END;
      BEGIN
        b:=1.0;
        IF i<0 THEN
          i:=-i;
          La:=Rec(La)
        ELSIF i=0 THEN
          OK:=TRUE;
          RETURN b
        END;
        m:=15;
        ib.i:=i;
        WHILE ~(m IN ib.b) DO DEC(m) END;
        FOR k:=0 TO m DO
          IF k IN ib.b THEN b:=b*La END;
          IF k<m THEN
            r:=Rec(La);
            IF ABS(La)>One THEN
              OK:=(ABS(b)<(MAX(LONGREAL)*r)*r) &
                  (ABS(La)<MAX(LONGREAL)*ABS(r))
            ELSIF ABS(La)<One THEN
              OK:=(ABS(b)>(MinLong*r)*r) &
                  (ABS(La)>MinLong*ABS(r))
            ELSE
              OK:=TRUE
            END;
            IF OK THEN La:=La*La ELSE RETURN Zero END
          END
        END;
        RETURN b
      END Latoi;

    PROCEDURE StringToLongReal
          (VAR s : ARRAY OF CHAR; VAR val : LONGREAL; VAR ReadOK : BOOLEAN);
      VAR nege : BOOLEAN;
          pos  : INTEGER;
          i    : INTEGER;
          tch  : CHAR;
          rval, sval, fct  : LONGREAL;
          temp : INTEGER;
      PROCEDURE ReadCH(VAR ch : CHAR);
        BEGIN
          ReadOK:=pos<HIGH(s);
          IF ReadOK THEN
            ch:=s[pos];
            INC(pos)
          ELSE
            ch:=' '
          END
        END ReadCH;
    BEGIN
      pos:=0;
      ReadCH(tch);
      IF ~ReadOK THEN RETURN END;
      WHILE tch=' ' DO
        ReadCH(tch);
        IF ~ReadOK THEN RETURN END
      END;
      neg:=tch='-';
      IF neg OR (tch='+') THEN
        ReadCH(tch);
        IF ~ReadOK THEN RETURN END
      END;
      sval:=0.0;
      ReadOK:=FALSE;
      WHILE (tch>='0') AND (tch<='9') DO
        sval:=Ten*sval+FLOATd(ORD(tch)-ORD('0'));
        ReadCH(tch);
        IF ~ReadOK THEN RETURN END
      END;
      IF tch='.' THEN
        ReadCH(tch);
        IF ~ReadOK THEN RETURN END;
        rval:=1.0;
        WHILE (tch>='0') AND (tch<='9') DO
          sval:=Ten*sval+FLOATd(ORD(tch)-ORD('0'));
          rval:=Ten*rval;
          ReadCH(tch);
          IF ~ReadOK THEN RETURN END
       END;
       sval:=sval*Rec(rval)
      END;
      IF tch='E' THEN
        ReadCH(tch);
        IF ~ReadOK THEN RETURN END;
        nege:=tch='-';
        IF nege OR (tch='+') THEN
          ReadCH(tch);
          IF ~ReadOK THEN RETURN END
        END;
        i:=0;
        LOOP
          IF (tch<'0') OR (tch>'9') THEN EXIT END;
          temp:=ORD(tch)-ORD('0');
          i:=10*i+temp;
          ReadCH(tch);
          IF ~ReadOK THEN RETURN END
        END;
        fct:=Latoi(Ten,i,ReadOK);
        IF ~ReadOK THEN RETURN END;
        IF nege THEN
          ReadOK:=sval>MinLong*fct;
          IF ~ReadOK THEN RETURN END;
          sval:=sval*Rec(fct)
        ELSE
          ReadOK:=sval<MAX(LONGREAL)*Rec(fct);
          IF ~ReadOK THEN RETURN END;
          sval:=sval*fct
        END
      END;
      IF ~ReadOK THEN RETURN END;
      IF neg THEN sval:=-sval END;
      val:=sval;
      ReadOK:=tch<=' '
    END StringToLongReal;

    PROCEDURE ReadLongReal(VAR a : LONGREAL);
      VAR s : String;
      BEGIN
        ReadString(s);
        Done:=InOut.Done;
        IF Done THEN StringToLongReal(s,a,Done) END
      END ReadLongReal;

    PROCEDURE LPreScale;
    (*        Convert the number to be in the range 1 to 10 (unless zero)
              i returns places shifted in process *)
      BEGIN
        neg:=La<Zero;
        IF neg THEN La:=-La END;
        (* calculate whole digits size *)
        i:=0;
        IF La<>Zero THEN
          WHILE La>=E14 DO
            La:=La*EM14;
            INC(i,14)
          END;
          WHILE La>=Ten DO
            La:=La*Tenth;
            INC(i)
          END;
          WHILE La<EM14 DO
            La:=E14*La;
            DEC(i,14);
            IF i<-308 THEN
              i:=0;
              La:=0.0;
              RETURN
            END
          END;
          WHILE La<One DO
            La:=Ten*La;
            DEC(i);
            IF i<-308 THEN
              i:=0;
              La:=0.0;
              RETURN
            END
          END
        END
      END LPreScale;

    PROCEDURE LongRealToString
               (VAR Text : ARRAY OF CHAR; c : LONGREAL; size : INTEGER);
      (* output a real number *)
      VAR sigdigits       : INTEGER;
          placesbeforedot : INTEGER;
          pos             : INTEGER;
          j               : INTEGER;
          k,l             : INTEGER;
          chs             : ARRAY [1..15] OF CHAR;
          dummy           : BOOLEAN;
      PROCEDURE WriteCH(ch : CHAR);
        BEGIN
          IF pos<HIGH(Text) THEN
            Text[pos]:=ch;
            INC(pos)
          END
        END WriteCH;
      BEGIN
        IF size>=HIGH(Text) THEN size:=HIGH(Text)-1 END;
        pos:=0;
        La:=c;
        LPreScale;
        placesbeforedot:=1;

        (*      Convert to engineering form if required.
                This code does so by shifting more digits in front of
                the dot.
                If you want to shift the other way, change the signs
                on the numbers. *)

        IF LongEngineering THEN
          WHILE (i MOD 3)<>0 DO
            DEC(i);
            INC(placesbeforedot);
          END
        END;

        (*      placesbeforedot now contains the number of places to
                precede the decimal point *)

        sigdigits:=size-7;
        IF sigdigits>LongSigDigits THEN sigdigits:=LongSigDigits END;
        IF sigdigits<2 THEN sigdigits:=2 END;
        IF sigdigits>LMaxDigits THEN sigdigits:=LMaxDigits END;
        IF LongEngineering & (sigdigits<3) THEN sigdigits:=3 END;
        IF size>sigdigits+7 THEN
          FOR l:=size-(sigdigits+7) TO 1 BY -1 DO WriteCH(' ') END
        END;
        IF neg THEN
          WriteCH('-')
        ELSE
          WriteCH(' ')
        END;
        La:=La+Latoi(Tenth,sigdigits,dummy)*Five;
        IF TRUNCd(La)>LONG(9) THEN
          La:=La*Tenth;
          INC(i)
        END;
        FOR l:=1 TO sigdigits DO
          k:=TRUNCd(La);
          IF k>9 THEN
            k:=9;
            La:=Ten
          END;
          WriteCH(CHR(k+ORD('0')));
          La:=Ten*(La-FLOATd(k));
          IF La<Zero THEN La:=Zero END;
          IF l=placesbeforedot THEN WriteCH('.') END
        END;
        IF (i<>0) OR LongForceExponent THEN
          WriteCH('E');
          IF i<0 THEN
            WriteCH('-');
            i:=-i
          ELSE
            WriteCH('+');
          END;
          FOR k:=1 TO 3 DO
            j:=i DIV 10;
            l:=i-10*j;
            chs[k]:=CHR(l+ORD('0'));
            i:=j
          END;
          FOR k:=3 TO 1 BY -1 DO  WriteCH(chs[k]) END
        END;
        Text[pos]:=0C
      END LongRealToString;

    PROCEDURE WriteLongReal(c : LONGREAL; size : INTEGER);
      VAR s : String;
      BEGIN
        LongRealToString(s,c,size);
        WriteString(s)
      END WriteLongReal;

    PROCEDURE LongRealToStringFixed
          (VAR Text : ARRAY OF CHAR; x : LONGREAL; size, places : INTEGER);
      (*  output a longreal number *)
      VAR  placesbeforedot  : INTEGER;
           wholeplaces      : INTEGER;
           pos, k, l        : INTEGER;
           digitnumber      : INTEGER;
           storeSigDigits   : INTEGER;
           storeEngineering : BOOLEAN;
           dummy            : BOOLEAN;
      PROCEDURE WriteCH(ch : CHAR);
        BEGIN
          IF pos<HIGH(Text) THEN
            Text[pos]:=ch;
            INC(pos)
          END
        END WriteCH;
      BEGIN
        IF size>=HIGH(Text) THEN size:=HIGH(Text)-1 END;
        pos:=0;
        La:=x;
        LPreScale;
        IF places>15 THEN places:=15 END;
        IF size=0 THEN size:=1 END;
        IF (size=1) & neg THEN size:=2 END;
        IF places>size-1 THEN places:=size-1 END;
        placesbeforedot:=size-places-1;
        IF neg & (placesbeforedot>0)THEN DEC(placesbeforedot) END;
        IF i<=0 THEN
          wholeplaces:=1;
          La:=ABS(x);
          i:=0
        ELSE
          wholeplaces:=i+1
        END;
        IF wholeplaces>placesbeforedot THEN
          storeSigDigits:=LongSigDigits;
          storeEngineering:=LongEngineering;
          LongSigDigits:=places+1;
          LongEngineering:=FALSE;
          LongRealToString(Text,x,size);
          LongSigDigits:=storeSigDigits;
          LongEngineering:=storeEngineering;
          RETURN
        END;
        La:=La+Latoi(Tenth,wholeplaces+places,dummy)*Five;
        FOR l:=placesbeforedot TO wholeplaces+1 BY -1 DO WriteCH(' ') END;
        IF neg THEN WriteCH('-') END;
        digitnumber:=1;
        FOR l:=wholeplaces TO 1 BY -1 DO
          k:=TRUNCd(La);
          IF k>9 THEN k:=9 END;
          IF digitnumber<=LMaxDigits THEN
            WriteCH(CHR(k+nul))
          ELSE
            WriteCH('0')
          END;
          INC(digitnumber);
          La:=Ten*(La-FLOATd(k));
          IF La<Zero THEN La:=Zero END
        END;
        IF digitnumber<=LMaxDigits THEN WriteCH('.') ELSE WriteCH(' ') END;
        FOR l:=1 TO places DO
          k:=TRUNCd(La);
          IF k>9 THEN k:=9; La:=Ten END;
          IF digitnumber<=LMaxDigits THEN
            WriteCH(CHR(k+ORD('0')))
          ELSE
            WriteCH(' ')
          END;
          INC(digitnumber);
          La:=Ten*(La-FLOATd(k));
          IF La<Zero THEN La:=Zero END
        END;
        Text[pos]:=0C
      END LongRealToStringFixed;

    PROCEDURE WriteLongRealFixed(x : LONGREAL; size, places : INTEGER);
      VAR s : String;
      BEGIN
        LongRealToStringFixed(s,x,size,places);
        WriteString(s)
      END WriteLongRealFixed;

  PROCEDURE WriteHexDig(C : INTEGER);
    BEGIN
      IF C>9 THEN INC(C,ORD('A')-ORD('9')-1) END;
      Write(CHR(C+nul))
    END WriteHexDig;

  PROCEDURE WriteOctGroup(C : CHAR);
    VAR p, q : CARDINAL;
    BEGIN
      p:=ORD(C);
      q:=p DIV 100B;
      WriteHexDig(q);
      p:=p-100B*q;
      q:=p DIV 10B;
      WriteHexDig(q);
      q:=p-10B*q;
      WriteHexDig(q)
    END WriteOctGroup;

  TYPE PLC = RECORD
               CASE : BOOLEAN OF
                 TRUE : P : POINTER TO CHAR |
                 FALSE: C : LONGCARD
               END
             END;

  PROCEDURE WriteRealOct(x : REAL; n : CARDINAL);
    VAR a : PLC;
        k : CARDINAL;
    BEGIN
      a.P:=ADR(x);
      FOR k:=1 TO 4 DO
        WriteOctGroup(a.P^);
        IF n>=16 THEN Write(' ') END;
        INC(a.C)
      END
    END WriteRealOct;

  PROCEDURE WriteLongRealOct(x : LONGREAL; n : CARDINAL);
    VAR a : PLC;
        k : CARDINAL;
    BEGIN
      a.P:=ADR(x);
      FOR k:=1 TO 8 DO
        WriteOctGroup(a.P^);
        IF n>=32 THEN Write(' ') END;
        INC(a.C)
      END
    END WriteLongRealOct;

  PROCEDURE WriteHexGroup(C : CHAR);
    VAR p, q : CARDINAL;
    BEGIN
      p:=ORD(C);
      q:=p DIV 10H;
      WriteHexDig(q);
      q:=p-10H*q;
      WriteHexDig(q)
    END WriteHexGroup;

  PROCEDURE WriteRealHex(x : REAL; n : CARDINAL);
    VAR a : PLC;
        k : CARDINAL;
    BEGIN
      a.P:=ADR(x);
      FOR k:=1 TO 4 DO
        WriteHexGroup(a.P^);
        IF n>=12 THEN Write(' ') END;
        INC(a.C)
      END
    END WriteRealHex;

  PROCEDURE WriteLongRealHex(x : LONGREAL; n : CARDINAL);
    VAR a : PLC;
        k : CARDINAL;
    BEGIN
      a.P:=ADR(x);
      FOR k:=1 TO 8 DO
        WriteHexGroup(a.P^);
        IF n>=24 THEN Write(' ') END;
        INC(a.C)
      END
    END WriteLongRealHex;

BEGIN

    Engineering:=FALSE;
    SigDigits:=MaxDigits;
    ForceExponent:=TRUE;
    MINREAL:=1.0/MAX(REAL);

    LongEngineering:=FALSE;
    LongSigDigits:=LMaxDigits;
    LongForceExponent:=TRUE;

    nul:=ORD('0');

    Zero:=0.0;
    One :=1.0;
    Five:=5.0;
    Ten :=10.0;
    TwoEM16:=2.0E-16;
    Tenth:=Rec(Ten);
    E14:=1.0E14;
    EM14:=Rec(E14);
    EM4 :=Rec(1.0E4);
    EM8 :=Rec(1.0E8);
    EM12:=Rec(1.0E12);
    EM16:=Rec(1.0E16);
    EM20:=Rec(1.0E20);
    MinLong:=One/MAX(LONGREAL);



END RealInOut.